home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / PBC30.ZIP / DCAL.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-11-12  |  5.5 KB  |  158 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.  
  8.    DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, VAttr%)
  9.    DECLARE SUB DateA2R (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, RelDate&)
  10.    DECLARE SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
  11.    DECLARE SUB DXQPrint (BYVAL DSeg%, BYVAL DOfs%, St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%)
  12.    DECLARE SUB Month0 (MonthName$, NameLen%, MonthNumber%)
  13.  
  14. SUB DCal (Scrn%(), CalDate$)
  15.    CalcAttr 5, 0, FrameAttr%           ' outer frame
  16.    CalcAttr 5, 1, GridAttr%            ' grid
  17.    CalcAttr 11, 5, MonthNameAttr%      ' month and year
  18.    CalcAttr 1, 7, DayNameAttr%         ' days of the week
  19.    CalcAttr 5, 1, EdgeDayAttr%         ' days in previous and next months
  20.    CalcAttr 15, 1, WeekdayAttr%        ' weekdays
  21.    CalcAttr 7, 1, WeekendAttr%         ' weekends
  22.    CalcAttr 14, 1, TodayAttr%          ' today, if showing current month
  23.  
  24.    L% = LBOUND(Scrn%)
  25.  
  26. ' --------------- draw the outer frame ----------------------------------------
  27.  
  28.    St$ = "┌──────────────────────────────────┐"
  29.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 5, 43, FrameAttr%
  30.    St$ = "├──────────────────────────────────┤"
  31.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 8, 43, FrameAttr%
  32.    St$ = "└──────────────────────────────────┘"
  33.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 22, 43, FrameAttr%
  34.    Row% = 6
  35.    St$ = "│                                  │"
  36.    DO
  37.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, 43, FrameAttr%
  38.       IF Row% = 7 THEN
  39.          Row% = 9
  40.       ELSE
  41.          Row% = Row% + 1
  42.       END IF
  43.    LOOP UNTIL Row% > 21
  44.  
  45. ' --------------- fill in the header info -------------------------------------
  46.  
  47.    IF LEN(CalDate$) >= 8 THEN
  48.       MonthNr% = VAL(CalDate$)
  49.       YearNr% = VAL(MID$(CalDate$, 7))
  50.    ELSE
  51.       St$ = DATE$
  52.       MonthNr% = VAL(St$)
  53.       YearNr% = VAL(MID$(St$, 7))
  54.    END IF
  55.  
  56.    IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
  57.  
  58.    IF MonthNr% = CINT(VAL(DATE$)) AND YearNr% = CINT(VAL(MID$(DATE$, 7))) THEN
  59.       CurrentMonth% = -1
  60.       Today% = CINT(VAL(MID$(DATE$, 4)))
  61.    END IF
  62.  
  63.    MonthName$ = SPACE$(9)
  64.    Month0 MonthName$, MLen%, MonthNr%
  65.    MonthName$ = LEFT$(MonthName$, MLen%)
  66.    St$ = SPACE$(34)
  67.    MID$(St$, 17 - (LEN(MonthName$) + 6) \ 2) = MonthName$ + STR$(YearNr%)
  68.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 6, 44, MonthNameAttr%
  69.  
  70.    St$ = " Su   Mo   Tu   We   Th   Fr   Sa "
  71.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 7, 44, DayNameAttr%
  72.  
  73. ' --------------- draw the grid -----------------------------------------------
  74.  
  75.    St$ = "────┬────┬────┬────┬────┬────┬────"
  76.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 9, 44, GridAttr%
  77.    FOR Row% = 10 TO 18 STEP 2
  78.       St$ = "    │    │    │    │    │    │    "
  79.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, 44, GridAttr%
  80.       St$ = "────┼────┼────┼────┼────┼────┼────"
  81.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row% + 1, 44, GridAttr%
  82.    NEXT
  83.    St$ = "    │    │    │    │    │    │    "
  84.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 20, 44, GridAttr%
  85.    St$ = "────┴────┴────┴────┴────┴────┴────"
  86.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 21, 44, GridAttr%
  87.  
  88. ' --------------- calculate necessary info ------------------------------------
  89.  
  90.    DateA2R MonthNr%, 1, YearNr%, RelDate&
  91.    IF MonthNr% = 12 THEN
  92.       DateA2R 1, 1, YearNr% + 1, NextDate&
  93.    ELSE
  94.       DateA2R MonthNr% + 1, 1, YearNr%, NextDate&
  95.    END IF
  96.    DaysInMonth% = NextDate& - RelDate&
  97.    DateR2A M%, DaysLastMonth%, Y%, RelDate& - 1&
  98.  
  99. ' --------------- do the calendar ---------------------------------------------
  100.  
  101.    WDay% = 0
  102.    DayNr% = DaysLastMonth% - RelDate& MOD 7& + 1
  103.    R% = 0: C% = 0
  104.    WHILE DayNr% <= DaysLastMonth%
  105.       St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
  106.       Row% = R% * 2 + 10
  107.       Col% = C% * 5 + 44
  108.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, EdgeDayAttr%
  109.       DayNr% = DayNr% + 1
  110.       WDay% = (WDay% + 1) MOD 7
  111.       IF WDay% THEN
  112.          C% = C% + 1
  113.       ELSE
  114.          R% = R% + 1
  115.          C% = 0
  116.       END IF
  117.    WEND
  118.  
  119.    DayNr% = 1
  120.    WHILE DayNr% <= DaysInMonth%
  121.       St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
  122.       Row% = R% * 2 + 10
  123.       Col% = C% * 5 + 44
  124.       IF CurrentMonth% AND (DayNr% = Today%) THEN
  125.          VAttr% = TodayAttr%
  126.       ELSEIF WDay% = 0 OR WDay% = 6 THEN
  127.          VAttr% = WeekendAttr%
  128.       ELSE
  129.          VAttr% = WeekdayAttr%
  130.       END IF
  131.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, VAttr%
  132.       DayNr% = DayNr% + 1
  133.       WDay% = (WDay% + 1) MOD 7
  134.       IF WDay% THEN
  135.          C% = C% + 1
  136.       ELSE
  137.          R% = R% + 1
  138.          C% = 0
  139.       END IF
  140.    WEND
  141.  
  142.    DayNr% = 1
  143.    WHILE R% <= 5 AND C% <= 6
  144.       St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
  145.       Row% = R% * 2 + 10
  146.       Col% = C% * 5 + 44
  147.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, EdgeDayAttr%
  148.       DayNr% = DayNr% + 1
  149.       WDay% = (WDay% + 1) MOD 7
  150.       IF WDay% THEN
  151.          C% = C% + 1
  152.       ELSE
  153.          R% = R% + 1
  154.          C% = 0
  155.       END IF
  156.    WEND
  157. END SUB
  158.